home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tvdmx.exe / STDDMX.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-16  |  14KB  |  472 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    StdDMX   --Standard Interface Unit        }
  5. {    tvDMX    --data editing project (ver 1.41)    }
  6. {                            }
  7. {    Copyright (c) 1992  Randolph Beck        }
  8. {                P.O. Box  56-0487        }
  9. {                Orlando, FL 32856        }
  10. {                CIS:  72361,753        }
  11. {                            }
  12. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  13.  
  14. Unit StdDMX;
  15.  
  16. {  This unit has been updated with a special frame for tvDMX windows that
  17.    limits the size of data windows according to the width of their headers.
  18.  }
  19.  
  20. {$B-,D-,O+,R-,X+,V- }
  21.  
  22. interface
  23.  
  24. uses  Objects, Drivers, Views, Dialogs, RSet, DmxGizma, tvDMX;
  25.  
  26. type
  27.     PDmxEditDlg  = ^TDmxEditDlg;  { tvDMX editor for dialog boxes }
  28.     PInputFields = ^TInputFields; { line-editor for dialog boxes }
  29.     PCutFrame     = ^TCutFrame;      { special frame for smaller windows }
  30.     PDmxViewer   = ^TDmxViewer;   { tvDMX data scroller window }
  31.     PDmxWindow   = ^TDmxWindow;   { tvDMX data editor window  }
  32.  
  33.  
  34.     TDmxEditDlg  =  object (TDmxEditor)
  35.       function  GetPalette  : PPalette;  VIRTUAL;
  36.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  37.     end;
  38.  
  39.  
  40.     TInputFields =  object (TDmxEditDlg)
  41.       constructor Init (InfoStr : string; var Bounds : TRect);
  42.       procedure InitData (var AData );  VIRTUAL;
  43.       procedure DoneData;  VIRTUAL;
  44.       procedure LoadData (var S : TStream);  VIRTUAL;
  45.       procedure StoreData (var S : TStream);  VIRTUAL;
  46.       function  DataSize  : word;  VIRTUAL;
  47.       procedure GetData (var Rec );  VIRTUAL;
  48.       procedure SetData (var Rec );  VIRTUAL;
  49.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  50.       procedure SetState (AState : word; Enable : boolean);  VIRTUAL;
  51.       procedure SetUpField;  VIRTUAL;
  52.     end;
  53.  
  54.  
  55.     TCutFrame    =  OBJECT (TFrame)
  56.       procedure Draw;  VIRTUAL;
  57.     end;
  58.  
  59.  
  60.     TDmxViewer   =  OBJECT (TWindow)
  61.     Limit  : TPoint;
  62.       constructor Init (var Bounds : TRect;  ATitle : TTitleStr;  ANumber : integer;
  63.                             ATemplate : string;  var AData;  BSize : longint;
  64.                         var ALabels  : string);
  65.       procedure InitDMX (ATemplate  : string;  var AData;
  66.                            ALabels, ARecInd  : PDmxLink;
  67.                            BSize  : longint);  VIRTUAL;
  68.       procedure ChangeBounds (var Bounds : TRect);  VIRTUAL;
  69.       procedure InitFrame;  VIRTUAL;
  70.       function  NewDmxLabels (var ALabels ) : PDmxLink;  VIRTUAL;
  71.       function  Valid (Command : word) : boolean;  VIRTUAL;
  72.       procedure Zoom;  VIRTUAL;
  73.     end;
  74.  
  75.  
  76.     TDmxWindow   =  OBJECT (TDmxViewer)
  77.       constructor Init (var Bounds : TRect;  ATitle : TTitleStr;  ANumber : integer;
  78.                             ATemplate : string;  var AData;  BSize : longint;
  79.                         var ALabels  : string;  IndLen  : integer);
  80.       procedure InitDMX (ATemplate  : string;  var AData;
  81.                          ALabels, ARecInd  : PDmxLink;
  82.                          BSize  : longint);  VIRTUAL;
  83.       function  NewRecInd (Len : integer) : PDmxLink;  VIRTUAL;
  84.     end;
  85.  
  86.  
  87.  
  88.   function  InsertField (Dialog : PDialog;  Col,Row : integer;
  89.                          Fmt : boolean;  ALabel,ATemplate : string)  : PView;
  90.  
  91.   procedure RegisterStdDMX;
  92.  
  93.  
  94. const
  95.     RDmxEditDlg  :  TStreamRec = (
  96.         ObjType:  cmDMX + 5;
  97.         VmtLink:  ofs (TypeOf (TDmxEditDlg)^);
  98.         Load:     @TDmxEditDlg.Load;
  99.         Store:    @TDmxEditDlg.Store
  100.       );
  101.  
  102.     RInputFields :  TStreamRec = (
  103.         ObjType:  cmDMX + 6;
  104.         VmtLink:  ofs (TypeOf (TInputFields)^);
  105.         Load:     @TInputFields.Load;
  106.         Store:    @TInputFields.Store
  107.       );
  108.  
  109.     RDmxWindow   :  TStreamRec = (
  110.         ObjType:  cmDMX + 7;
  111.         VmtLink:  ofs (TypeOf (TDmxWindow)^);
  112.         Load:     @TDmxWindow.Load;
  113.         Store:    @TDmxWindow.Store
  114.       );
  115.  
  116.     RDmxViewer   :  TStreamRec = (
  117.         ObjType:  cmDMX + 8;
  118.         VmtLink:  ofs (TypeOf (TDmxViewer)^);
  119.         Load:     @TDmxViewer.Load;
  120.         Store:    @TDmxViewer.Store
  121.       );
  122.  
  123.     RCutFrame     :  TStreamRec = (
  124.         ObjType:  cmDMX + 9;
  125.         VmtLink:  ofs (TypeOf (TCutFrame)^);
  126.         Load:     @TCutFrame.Load;
  127.         Store:    @TCutFrame.Store
  128.       );
  129.  
  130.  
  131. implementation
  132.  
  133.  
  134.   { ══════════════════════════════════════════════════════════════════════ }
  135.  
  136.  
  137. function  InsertField (Dialog : PDialog;  Col,Row : integer;
  138.                        Fmt : boolean;  ALabel,ATemplate : string)  : PView;
  139. var  i  : integer;
  140.      R  : TRect;
  141.      B  : PView;
  142. begin
  143.   With Dialog^ do
  144.     begin
  145.     i  := succ (CStrLen (ALabel));
  146.     R.Assign (Col, Row, Col + DmxStrLen (ATemplate), succ (Row));
  147.     If (ALabel <> '') then
  148.       begin
  149.       If Fmt then R.Move (1, 1) else R.Move (i, 0);
  150.       end;
  151.     B  := New (PInputFields, Init (ATemplate, R));
  152.     Insert (B);
  153.     If (ALabel <> '') then
  154.       begin
  155.       R.Assign (Col, Row, Col + i, succ (Row));
  156.       Insert (New (PLabel, Init (R, ALabel, B)));
  157.       end;
  158.     end;
  159.   InsertField := B;
  160. end;
  161.  
  162.  
  163.   { ══ TDmxEditDlg ══════════════════════════════════════════════════════ }
  164.  
  165.  
  166. function  TDmxEditDlg.GetPalette  : PPalette;
  167. {  6 border --------------------------------------+  }
  168. {  5 delimiter --------------------------------+  |  }
  169. {  4 locked field --------------------------+  |  |  }
  170. {  3 read-only selected field -----------+  |  |  |  }
  171. {  2 normal selected field -----------+  |  |  |  |  }
  172. {  1 normal fields ----------------+  |  |  |  |  |  }
  173. {                                  |  |  |  |  |  |  }
  174. const CDmxEditDlg : string [6] = #19#20#06#06#01#02; { similar to CInputLine }
  175. begin
  176.   GetPalette := @CDmxEditDlg
  177. end;
  178.  
  179.  
  180. procedure TDmxEditDlg.HandleEvent (var Event : TEvent);
  181. begin
  182.   With Event do
  183.     If (What = evKeyboard) and
  184.       ((KeyCode = kbTab) or (KeyCode = kbShiftTab) or (KeyCode = kbEsc)) then
  185.       TDmxScroller.HandleEvent (Event)
  186.      else
  187.       TDmxEditor.HandleEvent (Event);
  188. end;
  189.  
  190.  
  191.   { ══ TInputFields ══════════════════════════════════════════════════════ }
  192.  
  193.  
  194. constructor TInputFields.Init (InfoStr : string;  var Bounds : TRect);
  195. begin
  196.     { init with no data }
  197.   TDmxEditDlg.Init (^A + InfoStr, Mem [0:0], 0, Bounds, nil,nil, nil,nil);
  198.   GrowMode := gfGrowHiX;
  199. end;
  200.  
  201.  
  202. procedure TInputFields.InitData (var AData );
  203. { allocates memory for the data }
  204. begin
  205.   DataBlockSize := Size.Y * RecordSize;  { correct improper size }
  206.   GetMem (WorkingData, DataBlockSize);
  207.   fillchar (WorkingData^, DataBlockSize, 0);
  208.   TDmxEditDlg.InitData (WorkingData^);
  209. end;
  210.  
  211.  
  212. procedure TInputFields.DoneData;
  213. begin
  214.   TDmxEditDlg.DoneData;
  215.   FreeMem (WorkingData, DataBlockSize);
  216. end;
  217.  
  218.  
  219. procedure TInputFields.LoadData (var S : TStream);
  220. begin
  221.   S.Read (DataBlockSize, sizeof (DataBlockSize));
  222.   GetMem (WorkingData,  DataBlockSize);
  223.   S.Read (WorkingData^, DataBlockSize);
  224. end;
  225.  
  226.  
  227. procedure TInputFields.StoreData (var S : TStream);
  228. begin
  229.   S.Write (DataBlockSize, sizeof (DataBlockSize));
  230.   S.Write (WorkingData^, DataBlockSize);
  231. end;
  232.  
  233.  
  234. function  TInputFields.DataSize  : word;
  235. begin
  236.   DataSize  := LongRec (DataBlockSize).Lo
  237. end;
  238.  
  239.  
  240. procedure TInputFields.GetData (var Rec );
  241. var  Len : word;
  242. begin
  243.   Len  := DataSize;
  244.   If (Len > 0) and (WorkingData <> nil) then Move (WorkingData^, Rec, Len);
  245. end;
  246.  
  247.  
  248. procedure TInputFields.SetData (var Rec );
  249. var  Len : word;
  250. begin
  251.   Len  := DataSize;
  252.   If (Len > 0) and (WorkingData <> nil) then Move (Rec, WorkingData^, Len);
  253.   DrawView;
  254. end;
  255.  
  256.  
  257. procedure TInputFields.HandleEvent (var Event : TEvent);
  258. begin
  259.   With Event do
  260.     If (What = evKeyboard) then
  261.       begin
  262.       If ((KeyCode = kbPgUp) or (KeyCode = kbUp)) and (CurrentRecord = 0) then
  263.         KeyCode := kbShiftTab;
  264.       If ((KeyCode = kbPgDn) or (KeyCode = kbDown)
  265.           or ((KeyCode = kbEnter) and (CurrentField^.Next = nil)))
  266.          and (succ (CurrentRecord) = Limit.Y)
  267.        then
  268.         KeyCode := kbTab;
  269.       end;
  270.   TDmxEditDlg.HandleEvent (Event);
  271. end;
  272.  
  273.  
  274. procedure TInputFields.SetState (AState : word; Enable : boolean);
  275. var  cmd    : word;
  276.